home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
pctjoc85.arc
/
ETIME.F77
< prev
next >
Wrap
Text File
|
1985-03-16
|
2KB
|
65 lines
subroutine etime (e, s, display)
integer*2 e (4), s (4)
integer*2 display
integer*2 i, now (4)
real*4 time bar, average
character punct (4)
data punct / ' ', ':', ':', '.'/
call time (now)
call subtime (e, s, now)
if (display .ge. 0) then
write (*, 98) (punct (i), e (i), i = 1, 4)
if (display .gt. 0) then
average = time bar (e, display)
write (*, 99) display, average
end if
end if
return
98 format (' elspsed time', 4(a1, i2))
99 format (' average time for ', i3, ' iterations',
1 f9.3, ' seconds')
end
subroutine subtime (delta, start, stop)
integer*2 delta (4), start (4), stop (4)
integer*2 i, borrow
integer*2 adjust (4)
data adjust / 24, 60, 60, 100/
borrow = 0
do 1 i = 4, 1, -1
delta (i) = stop (i) - start (i) - borrow
if (delta (i) .lt. 0) then
delta (i) = delta (i) + adjust (i)
borrow = 1
else
borrow = 0
end if
1 continue
return
end
real*4 function time bar (time, n)
integer*2 time (4)
integer*2 n
integer*4 hseconds
integer*4 convert (4)
integer*2 i
data convert / 60, 60, 100, 1/
hseconds = 0
do 1 i = 1, 4
hseconds
1 = convert (i)*(hseconds + time (i))
1 continue
time bar = float (hseconds) / float (n) / 100.0
return
end